// we try to build a clean but inefficient  STG machine

// We have a simple minded (boxed) Value type
// in order to avoid duplicated work these must
// be heap-allocated

#include <new>

struct V {
  enum When { Now, Later };
  When when;
  union What { int i; struct Lzy* closure; };
  What what;
  V(int i) : when(Now) { what.i = i; }
  V(Lzy* closure) : when(Later) { what.closure = closure; }
};

template <int i>
struct Cnst : V {
  Cnst(void) : V(i) {}
  static Cnst is;
};

template <int i>
Cnst<i> Cnst<i>::is;

int force(V&);

// closures that have an environment
struct Lzy {
  V& (*forcer)(Lzy&);
  template <class T> struct adapt {
    static V& forcer(Lzy& lzy) {
      return static_cast<T&>(lzy).operator () ();
    };
  };
  Lzy(V& (*f)(Lzy&)) : forcer(f) {}
};


// 'let' allocates

// running example: fib n = case n of 0 -> 0; 1 -> 1; _ -> let res = fib (n - 1) + fib (n - 2) in res

int Plus(int a, int b) { return a + b; }
int Minus(int a, int b) { return a - b; }

// binop closure
//
template <int (*f)(int, int)>
struct Bin : V, Lzy {
  V& arg1;
  V& arg2;
  Bin(V& arg1, V& arg2) : V(this), Lzy(adapt<Bin>::forcer), arg1(arg1), arg2(arg2) {}
  V& operator () (void) {
    return *new (this) V(f(force(arg1), force(arg2)));
  }
};

// fib closure
//
struct Fib : V, Lzy {
  V& arg;
  Fib(V& arg) : V(this), Lzy(adapt<Fib>::forcer), arg(arg) {}
  V& operator () (void) {
    switch (int i = force(arg)) {
    case 0: return Cnst<0>::is;
    case 1: return Cnst<1>::is;
    default: return *new (this) V(*new Bin<Plus>(*new Fib(*new V(i - 1)),
						 *new Fib(*new V(i - 2))));
    };
  }
};

// 'case' forces & updates

int force(V& v) {
  switch (v.when) {
  case V::Later:
    return force(v.what.closure->forcer(*v.what.closure));
  case V::Now: return v.what.i;
  }
}

// TODO: 'case' on ADTs

int main(void) {
  // let a = fib 10 in a
  V& a = *new Fib(Cnst<10>::is);
  return 55 != force(a);
}
